home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol260 / attrib.pqs / attrib.pas
Encoding:
Pascal/Delphi Source File  |  1985-08-30  |  3.9 KB  |  135 lines
  1. {  Changes files attributes under MS-, PC-DOS.  File attributes include read
  2.     only, system, hidden, archived, directory, and volume name.  The last two
  3.     cannot be changed with this program.
  4.     
  5.   MS-DOS file attribute editor version 1.00A by Bela Lubkin 1/10/85
  6.   Send suggestions via Borland SIG on CompuServe - GO BOR }
  7.  
  8. Program Attributes;
  9.  
  10.   Const
  11.     AN: Array [0..7] Of String[13]=
  12.           ('Read only','Hidden','System','Volume name','Directory',
  13.            'Not archived','Unknown ($40)','Unknown ($80)');
  14.     NA: Array [0..7] Of String[12]=
  15.           ('Read only','Read/write','Hidden','Visible',
  16.            'System','Non-system','Not archived','Archived');
  17.  
  18.   Type
  19.     FileName=String[65];
  20.     DTA=Record
  21.           Junk: Array [0..20] Of Byte;
  22.           Attrib: Byte;
  23.           Time: Integer;
  24.           Date: Integer;
  25.           LSize: Integer;
  26.           HSize: Integer;
  27.           FN: Array [0..12] Of Char;
  28.         End;
  29.     RegisterSet=Record Case Integer Of
  30.                   1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  31.                   2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  32.                 End;
  33.  
  34.   Var
  35.     Path,FName,Found: FileName;
  36.     CurDTA: ^DTA;
  37.     Regs: RegisterSet;
  38.     Done,None,Changed,Prev: Boolean;
  39.     C,I,J: Integer;
  40.     CommandLine: String[127] Absolute CSEG:$0080;
  41.  
  42.   Begin
  43.     FName:=Copy(CommandLine,2,127);
  44.     If FName='' Then
  45.      Begin
  46.       Write('Enter file name: ');
  47.       ReadLn(FName);
  48.      End;
  49.     For I:=1 To Length(FName) Do FName[I]:=UpCase(FName[I]);
  50.     I:=Pos('\',FName);
  51.     If Pos(':',FName)<>0 Then I:=Pos(':',FName);
  52.     If I<>0 Then
  53.       Repeat
  54.         J:=Pos('\',Copy(FName,I+1,64));
  55.         I:=I+J;
  56.       Until J=0;
  57.     Path:=Copy(FName,1,I);
  58.     If Path=FName Then FName:=FName+'*.*';
  59.     FName[Length(FName)+1]:=Chr(0);
  60.     With Regs Do
  61.      Begin
  62.       AH:=$2F;
  63.       MsDos(Regs);
  64.       CurDTA:=Ptr(ES,BX);
  65.       AH:=$4E;
  66.       DS:=Seg(FName[1]);
  67.       DX:=Ofs(FName[1]);
  68.       CX:=$17;
  69.       MsDos(Regs);
  70.       Done:=False;
  71.       None:=True;
  72.       Repeat
  73.         If (Flags And 1)<>0 Then
  74.          Begin
  75.           Case AX Of
  76.             3: Write('Path not found');
  77.             15: Write('Invalid drive');
  78.             18: If None Then Write('File not found');
  79.             else Write('Unknown error #',AX);
  80.            End;
  81.           WriteLn;
  82.           Done:=True;
  83.          End
  84.         Else
  85.          Begin
  86.           None:=False;
  87.           Found:=Path+Copy(CurDTA^.FN,1,Pos(#0,CurDTA^.FN));
  88.           Write(Copy(Found,1,Length(Found)-1));
  89.           AX:=$4300;
  90.           DS:=Seg(Found[1]);
  91.           DX:=Ofs(Found[1]);
  92.           MsDos(Regs);
  93.           Write('(':Length(Path)-Length(Found)+15);
  94.           Prev:=False;
  95.           For I:=0 To 7 Do
  96.             If CX And (1 Shl I)<>0 Then
  97.              Begin
  98.               If Prev Then Write(',');
  99.               Write(AN[I]);
  100.               Prev:=True;
  101.              End;
  102.           WriteLn(')');
  103.           Changed:=False;
  104.           Repeat
  105.             Write('Change which attribute (0 for next file, -1 for list)? ');
  106.             C:=0;
  107.             ReadLn(C);
  108.             Case C Of
  109.               -1: WriteLn('#:Change to  1:',NA[CX And 1],'  2:',NA[(CX And 2) Shr 1+2],
  110.                           '  3:',NA[(CX And 4) Shr 2+4],
  111.                           '  4:',NA[(CX And 32) Shr 5+6]);
  112.                1: CX:=CX Xor 1;
  113.                2: CX:=CX Xor 2;
  114.                3: CX:=CX Xor 4;
  115.                4: CX:=CX Xor 32;
  116.              End;
  117.             If C In [1..4] Then Changed:=True;
  118.           Until C=0;
  119.           If Changed Then
  120.            Begin
  121.             AX:=$4301;
  122.             DS:=Seg(Found[1]);
  123.             DX:=Ofs(Found[1]);
  124.             CX:=CX And $FFE7;
  125.             MsDos(Regs);
  126.            End;
  127.           AH:=$4F;
  128.           MsDos(Regs);
  129.          End;
  130.       Until Done;
  131.      End;
  132.   End.
  133.    AH:=$2F;
  134.       MsDos(Regs);
  135.